New Star Software Collection/NSS_Collection.iso/3-004 ms visual basic pro 30/4.imz/4.IMA/TABLEOBJ.FR_/TABLEOBJ.bin

Text File | 1993-04-28 | 26KB | 1,012 lines

VERSION 2.00
Begin Form fTableObj
   BackColor       =   &H00C0C0C0&
   ClientHeight    =   3495
   ClientLeft      =   1335
   ClientTop       =   2625
   ClientWidth     =   5655
   Height          =   3900
   Icon            =   TABLEOBJ.FRX:0000
   KeyPreview      =   -1  'True
   Left            =   1275
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   3480
   ScaleMode       =   0  'User
   ScaleWidth      =   5675.317
   Tag             =   "Dynaset"
   Top             =   2280
   Width           =   5775
   Begin PictureBox FieldHeader
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   0  'None
      Height          =   240
      Left            =   0
      ScaleHeight     =   240
      ScaleMode       =   0  'User
      ScaleWidth      =   5028
      TabIndex        =   22
      Top             =   720
      Width           =   5025
      Begin Label FieldValueLabel
         BackColor       =   &H00C0C0C0&
         Caption         =   " Value  (F4=Zoom) "
         Height          =   255
         Left            =   1680
         TabIndex        =   24
         Top             =   0
         Width           =   3165
      End
      Begin Label FieldHdrLabel
         BackColor       =   &H00C0C0C0&
         Caption         =   "Field Name:"
         Height          =   252
         Left            =   120
         TabIndex        =   23
         Top             =   0
         Width           =   1212
      End
   End
   Begin PictureBox ViewButtons
      Align           =   1  'Align Top
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   0  'None
      Height          =   735
      Left            =   0
      ScaleHeight     =   735
      ScaleMode       =   0  'User
      ScaleWidth      =   5658.376
      TabIndex        =   1
      TabStop         =   0   'False
      Top             =   0
      Width           =   5655
      Begin ComboBox cIndexes
         BackColor       =   &H00FFFFFF&
         Height          =   300
         Left            =   720
         Style           =   2  'Dropdown List
         TabIndex        =   9
         Tag             =   "OL"
         Top             =   360
         Width           =   4335
      End
      Begin CommandButton SeekButton
         Caption         =   "&Seek"
         Height          =   330
         Left            =   2160
         TabIndex        =   5
         Top             =   0
         Width           =   750
      End
      Begin CommandButton FilterButton
         Caption         =   "F&ilter"
         Height          =   330
         Left            =   2880
         TabIndex        =   6
         Top             =   0
         Width           =   750
      End
      Begin CommandButton CloseButton
         Cancel          =   -1  'True
         Caption         =   "&Close"
         Height          =   330
         Left            =   4305
         TabIndex        =   8
         TabStop         =   0   'False
         Top             =   0
         Width           =   750
      End
      Begin CommandButton PropButton
         Caption         =   "&Prop"
         Height          =   330
         Left            =   3600
         TabIndex        =   7
         Top             =   0
         Width           =   750
      End
      Begin CommandButton DelButton
         Caption         =   "&Del"
         Height          =   330
         Left            =   1440
         TabIndex        =   4
         Top             =   0
         Width           =   750
      End
      Begin CommandButton EditButton
         Caption         =   "&Edit"
         Height          =   330
         Left            =   720
         TabIndex        =   3
         Top             =   0
         Width           =   750
      End
      Begin CommandButton AddButton
         Caption         =   "&Add"
         Height          =   330
         Left            =   0
         TabIndex        =   2
         Top             =   0
         Width           =   750
      End
      Begin Label IndexLabel
         BackColor       =   &H00C0C0C0&
         Caption         =   "Index:"
         Height          =   255
         Left            =   120
         TabIndex        =   25
         Top             =   400
         Width           =   615
      End
   End
   Begin PictureBox ChangeButtons
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   0  'None
      Height          =   690
      Left            =   0
      ScaleHeight     =   690
      ScaleMode       =   0  'User
      ScaleWidth      =   5658.376
      TabIndex        =   14
      TabStop         =   0   'False
      Top             =   0
      Visible         =   0   'False
      Width           =   5655
      Begin CommandButton UpdateButton
         Caption         =   "&Update"
         Height          =   372
         Left            =   960
         TabIndex        =   16
         Top             =   48
         Width           =   1212
      End
      Begin CommandButton CancelButton
         Caption         =   "&Cancel"
         Height          =   372
         Left            =   2640
         TabIndex        =   15
         Top             =   48
         Width           =   1212
      End
   End
   Begin PictureBox StatBox
      Align           =   2  'Align Bottom
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   0  'None
      Height          =   281
      Left            =   0
      ScaleHeight     =   298.153
      ScaleMode       =   0  'User
      ScaleWidth      =   5665.189
      TabIndex        =   20
      TabStop         =   0   'False
      Top             =   3210
      Width           =   5655
      Begin CommandButton NextButton
         Caption         =   ">"
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   12
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   287
         Left            =   4200
         TabIndex        =   12
         Top             =   0
         Width           =   375
      End
      Begin CommandButton LastButton
         Caption         =   ">|"
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   12
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   287
         Left            =   4575
         TabIndex        =   13
         Top             =   0
         Width           =   375
      End
      Begin CommandButton FirstButton
         Caption         =   "|<"
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   12
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   287
         Left            =   0
         TabIndex        =   10
         Top             =   0
         Width           =   375
      End
      Begin CommandButton PrevButton
         Caption         =   "<"
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   12
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   287
         Left            =   375
         TabIndex        =   11
         Top             =   0
         Width           =   375
      End
      Begin Label cStatusBar
         BackColor       =   &H00FFFFFF&
         BorderStyle     =   1  'Fixed Single
         Height          =   285
         Left            =   735
         TabIndex        =   21
         Top             =   0
         Width           =   3360
      End
   End
   Begin VScrollBar cScrollBar
      Height          =   2616
      LargeChange     =   3000
      Left            =   5040
      SmallChange     =   300
      TabIndex        =   19
      Top             =   960
      Visible         =   0   'False
      Width           =   252
   End
   Begin PictureBox cFields
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   0  'None
      Height          =   375
      Left            =   120
      ScaleHeight     =   372
      ScaleMode       =   0  'User
      ScaleWidth      =   4812
      TabIndex        =   17
      TabStop         =   0   'False
      Top             =   960
      Width           =   4815
      Begin TextBox cFieldData
         BackColor       =   &H00FFFFFF&
         DataSource      =   "Data1"
         ForeColor       =   &H00000000&
         Height          =   288
         Index           =   0
         Left            =   1560
         TabIndex        =   0
         Top             =   0
         Visible         =   0   'False
         Width           =   3252
      End
      Begin Label cFieldName
         BackColor       =   &H00C0C0C0&
         ForeColor       =   &H00000000&
         Height          =   252
         Index           =   0
         Left            =   0
         TabIndex        =   18
         Top             =   60
         Visible         =   0   'False
         Width           =   1572
      End
   End
End
Option Explicit

'form variables
Dim FTBL As Table             'current form's table
Dim FTblName As String        'form dynaset table name
Dim FBM As String             'form bookmark
Dim FNotFound As Integer      'used by find function
Dim FAtTop As Integer         'top flag
Dim FEditFlag As Integer      'edit mode
Dim FAddNewFlag As Integer    'add mode
Dim FFldDataChanged As Integer
Dim FSeekForm As New fSeek    'seek form instance
Dim FCurrRec As Integer       'record counter
Dim FNumbRows As Long         'total rows in Table

Sub AddButton_Click ()
  On Error GoTo AddErr

  'set the mode
  FTBL.AddNew
  cStatusBar = "Add record"
  FAddNewFlag = True
  If FTBL.RecordCount > 0 Then
    FBM = FTBL.Bookmark
  Else
    FBM = ""
  End If

  ChangeButtons.Visible = True
  ViewButtons.Visible = False
  NextButton.Enabled = False
  FirstButton.Enabled = False
  LastButton.Enabled = False
  PrevButton.Enabled = False

  ClearDataFields
  cFieldData(0).SetFocus
  GoTo AddEnd

AddErr:
  ShowError
  Resume AddEnd

AddEnd:

End Sub

Sub CancelButton_Click ()
   On Error Resume Next

   ChangeButtons.Visible = False
   ViewButtons.Visible = True
   NextButton.Enabled = True
   FirstButton.Enabled = True
   LastButton.Enabled = True
   PrevButton.Enabled = True

   FEditFlag = False
   FAddNewFlag = False
   If FBM <> "" Then FTBL.Bookmark = FBM
   DisplayCurrentRecord

End Sub

Sub cFieldData_Change (Index As Integer)
  'just set the flag if data is changed
  'it gets reset to false when a new record is displayed
  FFldDataChanged = True
End Sub

Sub cFieldData_KeyDown (Index As Integer, KeyCode As Integer, Shift As Integer)
  If KeyCode = &H73 Then   'F4
    cFieldName_DblClick Index

  ElseIf KeyCode = 34 And cScrollBar.Visible = True Then
    'pagedown with > 10 fields
    cScrollBar = cScrollBar - 3000

  ElseIf KeyCode = 33 And cScrollBar.Visible = True Then
    'pageup with > 10 fields
    cScrollBar = cScrollBar + 3000

  End If
End Sub

Sub cFieldData_KeyPress (Index As Integer, KeyAscii As Integer)
  'only allow return when in edit of add mode
  If FEditFlag = True Or FAddNewFlag = True Then
    If FTBL(Index).Type = FT_STRING And Len(cFieldData(Index)) > FTBL(Index).Size Then
      Beep
      MsgBox "Field Length Exceeded!", 48
      KeyAscii = 0
      Exit Sub
    End If
    If KeyAscii = 13 Then
      KeyAscii = 0
      SendKeys "{Tab}"
    End If

  'throw away the keystrokes if not in add or edit mode
  ElseIf FEditFlag = False And FAddNewFlag = False Then
    KeyAscii = 0
  End If

End Sub

Sub cFieldData_LostFocus (Index As Integer)
  On Error GoTo FldDataErr

  If FFldDataChanged = True Then
    'store the data in the field
    FTBL(Index) = cFieldData(Index)
  End If

  GoTo FldDataEnd

FldDataErr:
  ShowError
  Resume FldDataEnd

FldDataEnd:
  'reset for valid or error condition
  FFldDataChanged = False

End Sub

Sub cFieldName_DblClick (Index As Integer)
  On Error GoTo ZoomErr

  If FTBL(Index).Type = FT_STRING Or FTBL(Index).Type = FT_MEMO Then
     If FTBL(Index).FieldSize() < GETCHUNK_CUTOFF Then
       gstZoomData = cFieldData(Index)
     Else
       'add the rest of the field data with getchunk
       MsgBar "Getting Memo Field Data", True
       SetHourglass Me
       gstZoomData = cFieldData(Index) + StripNonAscii(FTBL(Index).GetChunk(GETCHUNK_CUTOFF, MAX_MEMO_SIZE))
       ResetMouse Me
       MsgBar "", False
     End If
     fZoom.Caption = Mid(cFieldName(Index), 1, Len(cFieldName(Index)) - 1)
     fZoom.Top = Top + 1200
     fZoom.Left = Left + 250
     If FAddNewFlag Or FEditFlag Then
       fZoom.SaveButton.Visible = True
       fZoom.CloseButton.Visible = True
     Else
       fZoom.CloseZoomButton.Visible = True
     End If
     fZoom.Show MODAL
     If FAddNewFlag Or FEditFlag Then
       If FTBL(Index).Type = FT_STRING And Len(gstZoomData) > FTBL(Index).Size Then
         Beep
         MsgBox "Field Length Exceeded, Data Truncated!", 48
         cFieldData(Index) = Mid(gstZoomData, 1, FTBL(Index).Size)
       Else
         cFieldData(Index) = gstZoomData
       End If
       FTBL(Index) = cFieldData(Index)
       FFldDataChanged = False
     End If
  End If
  GoTo ZoomEnd

ZoomErr:
  ShowError
  Resume ZoomEnd

ZoomEnd:

End Sub

Sub cIndexes_Click ()
  On Error GoTo IndErr

  If FTBL Is Nothing Then Exit Sub
  If FTBL.Index = Mid(cIndexes, 1, InStr(1, cIndexes, ":") - 1) Then Exit Sub

  FTBL.Index = Mid(cIndexes, 1, InStr(1, cIndexes, ":") - 1)
  FCurrRec = 1
  DisplayCurrentRecord
  FAtTop = True

  GoTo IndEnd

IndErr:
  ShowError
  Resume IndEnd

IndEnd:

End Sub

Sub ClearDataFields ()
  Dim i As Integer

  'clear out the fields on the main form
  For i = 0 To FTBL.Fields.Count - 1
    cFieldData(i) = ""
  Next
End Sub

Sub CloseButton_Click ()
  Unload Me
End Sub

Sub cScrollBar_Change ()
  Dim t As Integer

  t = cScrollBar
  If (t - 960) Mod 300 = 0 Then
    cFields.Top = t
  Else
    cFields.Top = ((t - 960) \ 300) * 300 + 960
  End If

End Sub

Sub DelButton_Click ()
  On Error GoTo DelRecErr

  If MsgBox("Delete Current Record?", MSGBOX_TYPE) = YES Then
    FTBL.Delete
    If gfTransPending Then gfDBChanged = True
    If FTBL.EOF = False Then
      FTBL.MoveNext
    End If
    FNumbRows = FNumbRows - 1
    DisplayCurrentRecord
  End If

  GoTo DelRecEnd

DelRecErr:
  ShowError
  Resume DelRecEnd

DelRecEnd:

End Sub

Sub DisplayCurrentRecord ()
   Dim i As Integer
   Dim cst As String    'current status bar
   Dim currstr As String

   On Error GoTo DCRErr

   SetHourglass Me

   If FCurrRec = -1 And FTBL.RecordCount = 0 Then
     currstr = "?"
   Else
     currstr = CStr(FCurrRec)
   End If
   cst = "Record "
   'check BOF/EOF flag so we know if we
   'are sitting on a valid record
   If FAddNewFlag = True Then
     cst = cst + currstr + " of " + CStr(FNumbRows)
   Else
     If FTBL.BOF = True Then
       FCurrRec = 0
       cst = cst + "(BOF) of " + CStr(FNumbRows)
       ClearDataFields
     ElseIf FTBL.EOF = True Then
       FCurrRec = FNumbRows + 1
       cst = cst + "(EOF) of " + CStr(FNumbRows)
       ClearDataFields
     Else
       cst = cst + currstr + " of " + CStr(FNumbRows)
       'place the data in the form fields
       For i = 0 To FTBL.Fields.Count - 1
         If FTBL(i).Type = FT_MEMO Then
           If FTBL(i).FieldSize() < GETCHUNK_CUTOFF Then
             cFieldData(i) = StripNonAscii(vFieldVal(FTBL(i)))
           Else
             cFieldData(i) = StripNonAscii(vFieldVal(FTBL(i).GetChunk(0, GETCHUNK_CUTOFF)))
           End If
         ElseIf FTBL(i).Type = FT_STRING Then
           cFieldData(i) = StripNonAscii(vFieldVal(FTBL(i)))
         Else
           cFieldData(i) = vFieldVal(FTBL(i))
         End If
       Next
     End If
   End If
   If gfUpdatable = False Then cst = cst + "  [Not Updatable]"
   cStatusBar = cst
   'set the flag
   FFldDataChanged = False

   GoTo DCREnd

DCRErr:
  ShowError
  Resume DCREnd

DCREnd:
   ResetMouse Me

End Sub

Sub EditButton_Click ()
   On Error GoTo EditErr

   FTBL.Edit
   cStatusBar = "Edit record"
   FEditFlag = True
   cFieldData(0).SetFocus
   FBM = FTBL.Bookmark

   ChangeButtons.Visible = True
   ViewButtons.Visible = False
   NextButton.Enabled = False
   FirstButton.Enabled = False
   LastButton.Enabled = False
   PrevButton.Enabled = False
   GoTo EditEnd

EditErr:
  ShowError
  Resume EditEnd

EditEnd:

End Sub

Sub FilterButton_Click ()
  On Error GoTo FilterErr

  Dim FilterStr As String
  Dim f As New fDynaset

  FilterStr = InputBox("Enter Filter Expression:")
  If FilterStr = "" Then Exit Sub

  gstTableDynaFilter = "select * from " + FTblName + " where " + FilterStr
  f.Show                           'open dynaset form w/ filtered table
  gstTableDynaFilter = ""
  GoTo FilterEnd

FilterErr:
  ShowError
  Resume FilterEnd

FilterEnd:

End Sub

Sub FirstButton_Click ()
   Dim ds As String
   On Error GoTo GoFirstError

   FTBL.MoveFirst
   FCurrRec = 1
   DisplayCurrentRecord
   FAtTop = True

   GoTo GoFirstEnd

GoFirstError:
   ShowError
   Resume GoFirstEnd

GoFirstEnd:
   ResetMouse Me
   MsgBar "", False

End Sub

Sub Form_KeyDown (KeyCode As Integer, Shift As Integer)
  If FEditFlag = True Or FAddNewFlag = True Then Exit Sub

  Select Case KeyCode
    Case 35                'end
      Call LastButton_Click
    Case 36                'home
      Call FirstButton_Click
    Case 38                'up arrow
      If Shift = 2 Then
        Call FirstButton_Click
      Else
        Call PrevButton_Click
      End If
    Case 40                'down arrow
      If Shift = 2 Then
        Call LastButton_Click
      Else
        Call NextButton_Click
      End If

  End Select

End Sub

Sub Form_Load ()
   Dim ft As Integer
   Dim i As Integer
   Dim tbl As tabledef
   Dim istr As String

   On Error GoTo TableErr

   SetHourglass Me
   MsgBar "Opening Table", True

   FTblName = fTables.cTableList
   Set tbl = gCurrentDB.TableDefs(FTblName)
   For i = 0 To tbl.Indexes.Count - 1
     istr = tbl.Indexes(i).Name
     istr = istr + ":" + tbl.Indexes(i).Fields
     If tbl.Indexes(i).Unique = True Then
       istr = istr + ":Unique"
     Else
       istr = istr + ":Non-Unique"
     End If
     If tbl.Indexes(i).Primary = True Then
       istr = istr + ":Primary"
     End If
     cIndexes.AddItem istr
   Next
   Set FTBL = gCurrentDB.OpenTable(FTblName)

   'show the first record
   FNumbRows = GetNumbRecsTbl(FTBL)          'query numb of recs

   'load the controls on the Table form
   cFieldName(0).Visible = True
   cFieldData(0).Visible = True
   ft = FTBL(0).Type
   cFieldData(0).Width = GetFieldWidth(ft)
   cFieldData(0).TabIndex = 0
   For i = 1 To FTBL.Fields.Count - 1
     cFields.Height = cFields.Height + 300
     Load cFieldName(i)
     cFieldName(i).Top = cFieldName(i - 1).Top + 300
     cFieldName(i).Visible = True
     Load cFieldData(i)
     cFieldData(i).Top = cFieldData(i - 1).Top + 300
     cFieldData(i).Visible = True
     ft = FTBL.Fields(i).Type
     cFieldData(i).Width = GetFieldWidth(ft)
     cFieldData(i).TabIndex = i
   Next

   'resize main window
   If i <= 10 Then
     Height = ((i + 1) * 300) + 1600
   Else
     Height = 4668
     Width = Width + 260
     cScrollBar.Visible = True
     cScrollBar.Min = 900
     cScrollBar.Max = 900 - (i * 300) + 3000
   End If

   'display the field names
   For i = 0 To FTBL.Fields.Count - 1
     cFieldName(i) = UCase(FTBL(i).Name) + ":"
   Next

   FCurrRec = 1
   If cIndexes.ListCount > 0 Then
     cIndexes.ListIndex = 0
   End If
   DisplayCurrentRecord      'display field values
   FAtTop = True

   Caption = "Table: " + FTblName
   Width = 5805
   Left = 1000
   Top = 1000

   GoTo OkayEnd

TableErr:
   ShowError
   ResetMouse Me
   Unload Me
   MsgBar "", False
   Exit Sub
   Resume OkayEnd

OkayEnd:
   ResetMouse Me
   MsgBar "", False

End Sub

Sub Form_Paint ()
  Outlines Me
End Sub

Sub Form_Resize ()
  On Error Resume Next

  Dim h As Integer, i As Integer
  Dim totw As Integer

  If WindowState <> 1 Then   'not minimized
    MsgBar "Resizing Form", True
    'make sure the form is lined up on a field
    h = Height
    If (h - 1660) Mod 300 <> 0 Then
      Height = ((h - 1660) \ 300) * 300 + 1660
    End If
    'resize the status bar
    StatBox.Top = Height - 650
    'resize the scrollbar
    cScrollBar.Height = StatBox.Top - (ViewButtons.Top - FieldHeader.Height) - 1200
    cScrollBar.Left = Width - 360
    If FTBL.Fields.Count > 10 Then
      cFields.Width = Width - 260
      totw = cScrollBar.Left - 20
    Else
      cFields.Width = Width - 20
      totw = Width - 50
    End If
    FieldHeader.Width = Width - 20
    'widen the fields if possible
    For i = 0 To FTBL.Fields.Count - 1
      cFieldName(i).Width = .3 * totw
      cFieldData(i).Left = cFieldName(i).Width + 20
      If FTBL(i).Type = FT_STRING Or FTBL(i).Type = FT_MEMO Then
        cFieldData(i).Width = .7 * totw - 250
      End If
    Next
    FieldValueLabel.Left = cFieldData(0).Left
    cStatusBar.Width = Width - 1600
    NextButton.Left = cStatusBar.Width + 745
    LastButton.Left = NextButton.Left + 370
  End If
  MsgBar "", False
End Sub

Sub Form_Unload (Cancel As Integer)
  On Error Resume Next

  Unload FSeekForm   'get rid of attached seek form
  FTBL.Close          'close the form Table
  MsgBar "", False
End Sub

Sub LastButton_Click ()
   On Error GoTo GoLastError

   FTBL.MoveLast
   'show the current record
   FCurrRec = FNumbRows
   DisplayCurrentRecord

   GoTo GoLastEnd

GoLastError:
   ShowError
   Resume GoLastEnd

GoLastEnd:

End Sub

Sub NextButton_Click ()
   On Error GoTo GoNextError

   FTBL.MoveNext
   'show the current record
   If FCurrRec <> -1 Then
     FCurrRec = FCurrRec + 1   'bump the record counter
   End If
   DisplayCurrentRecord
   FAtTop = False

   GoTo GoNextEnd

GoNextError:
   ShowError
   Resume GoNextEnd

GoNextEnd:

End Sub

Sub PrevButton_Click ()
   On Error GoTo GoPrevError

   FTBL.MovePrevious
   'show the current record
   If FCurrRec <> -1 Then
     FCurrRec = FCurrRec - 1   'bump the record counter back
   End If
   DisplayCurrentRecord
   FAtTop = False

   GoTo GoPrevEnd

GoPrevError:
   ShowError
   Resume GoPrevEnd

GoPrevEnd:

End Sub

Sub PropButton_Click ()
   Dim f As New fDataBox

   On Error GoTo DynPropErr

   Set gCurrentTbl = FTBL
   f.Caption = "Table Properties"
   f.Tag = "TBL"

   f.cData.AddItem "Name = " + FTBL.Name
   f.cData.AddItem "BOF Flag = " + stTrueFalse((FTBL.BOF))
   f.cData.AddItem "BookMark = " + FTBL.Bookmark
   f.cData.AddItem "BookMarkable Flag = " + stTrueFalse((FTBL.Bookmarkable))
   f.cData.AddItem "Date Created = " + FTBL.DateCreated
   f.cData.AddItem "EOF Flag = " + stTrueFalse((FTBL.EOF))
   f.cData.AddItem "Index = " + FTBL.Index
   f.cData.AddItem "Last Modified = " + FTBL.LastModified
   f.cData.AddItem "Last Updated = " + FTBL.LastUpdated
   f.cData.AddItem "Lock Edits Flag = " + stTrueFalse((FTBL.LockEdits))
   f.cData.AddItem "No Match Flag = " + stTrueFalse((FTBL.NoMatch))
   f.cData.AddItem "Transactions Flag = " + stTrueFalse((FTBL.Transactions))
   f.cData.AddItem "RecordCount = " & FTBL.RecordCount
   f.cData.AddItem "Updatable Flag = " + stTrueFalse((FTBL.Updatable))

   f.Show MODAL

  GoTo DynPropEnd

DynPropErr:
  f.cData.AddItem Error$
  Resume Next

DynPropEnd:

End Sub

Sub SeekButton_Click ()
  On Error GoTo SeekErr
  Dim bm As String

  If FTBL.RecordCount = 0 Then Exit Sub

SeekStart:
  MsgBar "Enter Seek Parameters", False
  fSeek.Show MODAL
  If gstSeekValue = "" Then GoTo SeekEnd

  bm = FTBL.Bookmark

  SetHourglass Me
  FTBL.Seek gstSeekOperator, gstSeekValue
  ResetMouse Me

  'return to old record if no match was found
  If FTBL.NoMatch And bm <> "" Then
    Beep
    MsgBox "Record Not Found", 48
    FTBL.Bookmark = bm
    GoTo SeekStart
  Else
    If FCurrRec <> -1 Then
      MsgBox "Current Record Number cannot be retained after Seek!"
    End If
    FCurrRec = -1  'set to -1 because it is no longer valid
  End If

  DisplayCurrentRecord
  GoTo SeekEnd

SeekErr:
  ResetMouse Me
  MsgBox Error$
  Resume SeekEnd

SeekEnd:
  MsgBar "", False

End Sub

Sub UpdateButton_Click ()
  On Error GoTo UpdateErr

  FTBL.Update
  If gfTransPending Then gfDBChanged = True

  If FAddNewFlag = True Then
    FNumbRows = FNumbRows + 1
    FCurrRec = FNumbRows
    FTBL.MoveLast               'move to the new record
  End If

  FEditFlag = False
  FAddNewFlag = False
  ChangeButtons.Visible = False
  ViewButtons.Visible = True
  NextButton.Enabled = True
  FirstButton.Enabled = True
  LastButton.Enabled = True
  PrevButton.Enabled = True
  DisplayCurrentRecord

  GoTo UpdateEnd

UpdateErr:
  ShowError
  Resume UpdateEnd

UpdateEnd:

End Sub